home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libs / f2c / libi77 / wref.c < prev    next >
C/C++ Source or Header  |  1994-05-06  |  4KB  |  246 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "fp.h"
  5. #ifndef VAX
  6. #include "ctype.h"
  7. #endif
  8.  
  9. #ifndef KR_headers
  10. #undef abs
  11. #undef min
  12. #undef max
  13. #include "stdlib.h"
  14. #include "string.h"
  15. #endif
  16.  
  17. #ifdef KR_headers
  18. wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
  19. #else
  20. wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
  21. #endif
  22. {
  23.     char buf[FMAX+EXPMAXDIGS+4], *s, *se;
  24.     int d1, delta, e1, i, sign, signspace;
  25.     double dd;
  26. #ifndef VAX
  27.     int e0 = e;
  28. #endif
  29.  
  30.     if(e <= 0)
  31.         e = 2;
  32.     if(f__scale) {
  33.         if(f__scale >= d + 2 || f__scale <= -d)
  34.             goto nogood;
  35.         }
  36.     if(f__scale <= 0)
  37.         --d;
  38.     if (len == sizeof(real))
  39.         dd = p->pf;
  40.     else
  41.         dd = p->pd;
  42.     if (dd < 0.) {
  43.         signspace = sign = 1;
  44.         dd = -dd;
  45.         }
  46.     else {
  47.         sign = 0;
  48.         signspace = (int)f__cplus;
  49. #ifndef VAX
  50.         if (!dd)
  51.             dd = 0.;    /* avoid -0 */
  52. #endif
  53.         }
  54.     delta = w - (2 /* for the . and the d adjustment above */
  55.             + 2 /* for the E+ */ + signspace + d + e);
  56.     if (delta < 0) {
  57. nogood:
  58.         while(--w >= 0)
  59.             PUT('*');
  60.         return(0);
  61.         }
  62.     if (f__scale < 0)
  63.         d += f__scale;
  64.     if (d > FMAX) {
  65.         d1 = d - FMAX;
  66.         d = FMAX;
  67.         }
  68.     else
  69.         d1 = 0;
  70.     sprintf(buf,"%#.*E", d, dd);
  71. #ifndef VAX
  72.     /* check for NaN, Infinity */
  73.     if (!isdigit(buf[0])) {
  74.         switch(buf[0]) {
  75.             case 'n':
  76.             case 'N':
  77.                 signspace = 0;    /* no sign for NaNs */
  78.             }
  79.         delta = w - strlen(buf) - signspace;
  80.         if (delta < 0)
  81.             goto nogood;
  82.         while(--delta >= 0)
  83.             PUT(' ');
  84.         if (signspace)
  85.             PUT(sign ? '-' : '+');
  86.         for(s = buf; *s; s++)
  87.             PUT(*s);
  88.         return 0;
  89.         }
  90. #endif
  91.     se = buf + d + 3;
  92.     if (f__scale != 1 && dd)
  93.         sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
  94.     s = ++se;
  95.     if (e < 2) {
  96.         if (*s != '0')
  97.             goto nogood;
  98.         }
  99. #ifndef VAX
  100.     /* accommodate 3 significant digits in exponent */
  101.     if (s[2]) {
  102. #ifdef Pedantic
  103.         if (!e0 && !s[3])
  104.             for(s -= 2, e1 = 2; s[0] = s[1]; s++);
  105.  
  106.     /* Pedantic gives the behavior that Fortran 77 specifies,    */
  107.     /* i.e., requires that E be specified for exponent fields    */
  108.     /* of more than 3 digits.  With Pedantic undefined, we get    */
  109.     /* the behavior that Cray displays -- you get a bigger        */
  110.     /* exponent field if it fits.    */
  111. #else
  112.         if (!e0) {
  113.             for(s -= 2, e1 = 2; s[0] = s[1]; s++)
  114. #ifdef CRAY
  115.                 delta--;
  116.             if ((delta += 4) < 0)
  117.                 goto nogood
  118. #endif
  119.                 ;
  120.             }
  121. #endif
  122.         else if (e0 >= 0)
  123.             goto shift;
  124.         else
  125.             e1 = e;
  126.         }
  127.     else
  128.  shift:
  129. #endif
  130.         for(s += 2, e1 = 2; *s; ++e1, ++s)
  131.             if (e1 >= e)
  132.                 goto nogood;
  133.     while(--delta >= 0)
  134.         PUT(' ');
  135.     if (signspace)
  136.         PUT(sign ? '-' : '+');
  137.     s = buf;
  138.     i = f__scale;
  139.     if (f__scale <= 0) {
  140.         PUT('.');
  141.         for(; i < 0; ++i)
  142.             PUT('0');
  143.         PUT(*s);
  144.         s += 2;
  145.         }
  146.     else if (f__scale > 1) {
  147.         PUT(*s);
  148.         s += 2;
  149.         while(--i > 0)
  150.             PUT(*s++);
  151.         PUT('.');
  152.         }
  153.     if (d1) {
  154.         se -= 2;
  155.         while(s < se) PUT(*s++);
  156.         se += 2;
  157.         do PUT('0'); while(--d1 > 0);
  158.         }
  159.     while(s < se)
  160.         PUT(*s++);
  161.     if (e < 2)
  162.         PUT(s[1]);
  163.     else {
  164.         while(++e1 <= e)
  165.             PUT('0');
  166.         while(*s)
  167.             PUT(*s++);
  168.         }
  169.     return 0;
  170.     }
  171.  
  172. #ifdef KR_headers
  173. wrt_F(p,w,d,len) ufloat *p; ftnlen len;
  174. #else
  175. wrt_F(ufloat *p, int w, int d, ftnlen len)
  176. #endif
  177. {
  178.     int d1, sign, n;
  179.     double x;
  180.     char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
  181.  
  182.     x= (len==sizeof(real)?p->pf:p->pd);
  183.     if (d < MAXFRACDIGS)
  184.         d1 = 0;
  185.     else {
  186.         d1 = d - MAXFRACDIGS;
  187.         d = MAXFRACDIGS;
  188.         }
  189.     if (x < 0.)
  190.         { x = -x; sign = 1; }
  191.     else {
  192.         sign = 0;
  193. #ifndef VAX
  194.         if (!x)
  195.             x = 0.;
  196. #endif
  197.         }
  198.  
  199.     if (n = f__scale)
  200.         if (n > 0)
  201.             do x *= 10.; while(--n > 0);
  202.         else
  203.             do x *= 0.1; while(++n < 0);
  204.  
  205. #ifdef USE_STRLEN
  206.     sprintf(b = buf, "%#.*f", d, x);
  207.     n = strlen(b) + d1;
  208. #else
  209.     n = sprintf(b = buf, "%#.*f", d, x) + d1;
  210. #endif
  211.  
  212.     if (buf[0] == '0' && d)
  213.         { ++b; --n; }
  214.     if (sign) {
  215.         /* check for all zeros */
  216.         for(s = b;;) {
  217.             while(*s == '0') s++;
  218.             switch(*s) {
  219.                 case '.':
  220.                     s++; continue;
  221.                 case 0:
  222.                     sign = 0;
  223.                 }
  224.             break;
  225.             }
  226.         }
  227.     if (sign || f__cplus)
  228.         ++n;
  229.     if (n > w) {
  230.         while(--w >= 0)
  231.             PUT('*');
  232.         return 0;
  233.         }
  234.     for(w -= n; --w >= 0; )
  235.         PUT(' ');
  236.     if (sign)
  237.         PUT('-');
  238.     else if (f__cplus)
  239.         PUT('+');
  240.     while(n = *b++)
  241.         PUT(n);
  242.     while(--d1 >= 0)
  243.         PUT('0');
  244.     return 0;
  245.     }
  246.